home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Splayset.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  7.5 KB  |  117 lines  |  [TEXT/R*ch]
  1. (* Splayset -- modified for Moscow ML 1995-04-22
  2.  * from SML/NJ library v. 0.2
  3.  *
  4.  * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  
  5.  * See file mosml/copyrght/copyrght.att for details.
  6.  *
  7.  * Set of values with an ordering relation, implemented as splay-trees.
  8.  *)
  9.  
  10. open Splaytree
  11.  
  12. datatype 'key set = 
  13.   OS of {cmpKey : 'key * 'key -> ordering,
  14.      root   : 'key splay ref,
  15.      nobj   : int}
  16.  
  17. exception NotFound
  18. fun cmpf cmpKey k = fn k' => cmpKey(k',k)
  19.  
  20. fun empty cmpKey = OS{cmpKey = cmpKey, root = ref SplayNil, nobj = 0}
  21.  
  22. fun singleton cmpKey v = 
  23.     OS{cmpKey= cmpKey, 
  24.        root = ref(SplayObj{value=v,left=SplayNil,right=SplayNil}),
  25.        nobj=1}
  26.  
  27. (* Primitive insertion. *)
  28. fun insert cmpKey (v,(nobj,root)) =
  29.       case splay (cmpf cmpKey v, root) of
  30.         (_,SplayNil) => 
  31.           (1,SplayObj{value=v,left=SplayNil,right=SplayNil})
  32.       | (EQUAL,SplayObj{value,left,right}) => 
  33.           (nobj,SplayObj{value=v,left=left,right=right})
  34.       | (LESS,SplayObj{value,left,right}) => 
  35.           (nobj+1,
  36.            SplayObj{
  37.              value=v,
  38.              left=SplayObj{value=value,left=left,right=SplayNil},
  39.              right=right})
  40.       | (GREATER,SplayObj{value,left,right}) => 
  41.           (nobj+1,
  42.            SplayObj{
  43.               value=v,
  44.               left=left,
  45.               right=SplayObj{value=value,left=SplayNil,right=right}})
  46.  
  47. (* Add an item. *)
  48. fun add (OS{cmpKey,root,nobj},v) = let
  49.       val (cnt,t) = insert cmpKey (v,(nobj,!root))
  50.       in
  51.         OS{cmpKey=cmpKey, nobj=cnt, root=ref t}
  52.       end
  53.  
  54. (* Insert a list of items. *)
  55. fun addList (OS{cmpKey,root,nobj},l) = let
  56.       val (cnt,t) = List.foldl (insert cmpKey) (nobj,!root) l
  57.       in OS{cmpKey=cmpKey, nobj=cnt, root=ref t} end
  58.  
  59. (* Look for an item, return NONE if the item doesn't exist *)
  60. fun peek (d as OS{cmpKey,root,nobj}, key) =
  61.       case splay (cmpf cmpKey key, !root) of
  62.         (_,SplayNil) => NONE
  63.       | (EQUAL,r as SplayObj{value,...}) => (root := r; SOME value)
  64.       | (_,r) => (root := r; NONE)
  65.  
  66. (* Find an item *)
  67. fun member arg = carcnt+1)
  68.                 end
  69.           val (root,cnt) = uni (!root) (!root')
  70.       in
  71.         OS{cmpKey = cmpKey, root = ref root, nobj = cnt}
  72.       end
  73.  
  74. (* Return a list of the items (and their keys) in the dictionary *)
  75. fun listItems (OS{root,...}) =
  76.     let fun apply SplayNil                     res = res
  77.           | apply (SplayObj{value,left,right}) res =
  78.               apply left (value :: apply right res)
  79.     in apply (!root) [] end
  80.  
  81. (* Apply a function to the entries of the dictionary *)
  82. fun app af (OS{root,...}) =
  83.       let fun apply SplayNil = ()
  84.             | apply (SplayObj{value,left,right}) = 
  85.                 (apply left; af value; apply right)
  86.     in
  87.       apply (!root)
  88.     end
  89.  
  90. fun revapp af (OS{root,...}) =
  91.     let fun apply SplayNil = ()
  92.       | apply (SplayObj{value,left,right}) = 
  93.         (apply right; af value; apply left)
  94.     in apply (!root) end
  95.  
  96. (* Fold function *)
  97. fun foldr abf b (OS{root,...}) =
  98.     let fun apply SplayNil                     res = res
  99.       | apply (SplayObj{value,left,right}) res =
  100.         apply left (abf(value, apply right res))
  101.     in apply (!root) b end
  102.  
  103. fun foldl abf b (OS{root,...}) =
  104.     let fun apply SplayNil                     res = res
  105.       | apply (SplayObj{value,left,right}) res =
  106.         apply right (abf(value, apply left b))
  107.     in apply (!root) b end
  108.  
  109. fun find p (OS{root,...}) = 
  110.     let fun ex SplayNil = NONE
  111.       | ex (SplayObj{value=v,left=l,right=r}) =
  112.             if p v then SOME v
  113.             else case ex l of
  114.         NONE => ex r
  115.           | a => a 
  116.     in ex (!root) end
  117.